9  Online Appendix B

9.1 Setup

9.1.1 Install Packages

We install the following packages using the groundhog package manager to increase computational reproducibility.

if (!requireNamespace("groundhog", quietly = TRUE)) {
    install.packages("groundhog")
}

pkgs <- c("magrittr", "data.table", "stringr", "lubridate", "knitr", "glue",
          "sandwich", "lmtest",
          "ggplot2", "ggpubr", "rstatix", "patchwork")

groundhog::groundhog.library(pkg = pkgs,
                             date = "2024-08-01")

rm(pkgs)

9.1.2 Read Data

# data <- data.table::fread(file = "../data/processed/full.csv")
data <- readRDS(file="../data/processed/full.Rda")

9.1.3 Design

We define some design features in the following:

colors <- c("#F3B05C", "#1E4A75", "#65B5C0", "#AD5E21")

layout <- theme(panel.background = element_rect(fill = "white"),
                legend.key = element_rect(fill = "white"),
                panel.grid.major.y = element_line(colour = "grey", 
                                                  linewidth = 0.25),
                axis.ticks.y = element_blank(),
                panel.grid.major.x = element_blank(),
                axis.line.x.bottom = element_line(colour = "#000000", 
                                                  linewidth = 0.5),
                axis.line.y.left = element_blank(),
                plot.title = element_text(size = rel(1))
)

9.1.4 Helper Function

plot_bars <- function(response = "b", surprise_sub = NA, limits = ylim(-0.1, 100.1)){
  
  if(response == "b"){
      y_1 = 75
      y_2 = 55
    } else {
      y_1 = 75
      y_2 = 60
    }
  
  if(!is.na(surprise_sub)){
    # Plot bottom panels
    tmp <- data[surprise == surprise_sub]
    names(tmp)[names(tmp) == response] <- 'outcome'
    
    if(surprise_sub){
      title <- "Surprising Condition"
    } else {
      title <- "Confirming Condition"
    }
    
    test_stats_1 <- tmp %>% 
      group_by(communication) %>%
      wilcox_test(formula = outcome ~ stage,
                  paired = T) %>% 
      adjust_pvalue(method = "none") %>%
      add_significance(p.col = "p.adj",
                       cutpoints = c(0, 0.01, 0.05, 0.1, 1),
                       symbols = c( "***", "**", "*", "ns")) %>%
      as.data.table()
    
    
    test_stats_2 <- tmp %>% 
      group_by(stage) %>%
      wilcox_test(formula = outcome ~ communication) %>% 
      adjust_pvalue(method = "none") %>%
      add_significance(p.col = "p.adj",
                       cutpoints = c(0, 0.01, 0.05, 0.1, 1),
                       symbols = c( "***", "**", "*", "ns")) %>%
      as.data.table()
    test_stats_2 <- test_stats_2[stage == 2]
    
    plot_bottom <- ggplot(data = tmp,
           mapping = aes(x = as.factor(communication),
                         y = outcome)) +
        geom_bar(aes(fill = stage),
                 position = "dodge", 
                 stat = "summary", 
                 fun = "mean") + 
      limits +
      scale_fill_manual(values=c("black", "gray")) +
      theme_classic() +
      stat_pvalue_manual(data = test_stats_2,
                         label = "{p} ({p.adj.signif})", 
                         step.group.by = "stage",
                         tip.length = 0, 
                         step.increase = 0.1, 
                         y.position = y_1) +
      stat_pvalue_manual(data = test_stats_1,
                         label = "{p} ({p.adj.signif})",
                         y.position = y_2,
                         tip.length = 0,
                         x = "communication") +
      labs(title = "",
           x = " Surprising Condition",
           y = glue(" {response}"))
    
    rm(tmp)
    
    plot_bottom
  } else {
    # Plot the top panel
    tmp <- data
    names(tmp)[names(tmp) == response] <- 'outcome'
    
    title <- "Both Conditions"
    
    test_stats_1 <- tmp %>% 
      group_by(surprise) %>%
      wilcox_test(formula = outcome ~ stage,
                  paired = T) %>% 
      adjust_pvalue(method = "none") %>%
      add_significance(p.col = "p.adj",
                       cutpoints = c(0, 0.01, 0.05, 0.1, 1),
                       symbols = c( "***", "**", "*", "ns")) %>%
      as.data.table()
    
    
    test_stats_2 <- tmp %>% 
      group_by(stage) %>%
      wilcox_test(formula = outcome ~ surprise) %>% 
      adjust_pvalue(method = "none") %>%
      add_significance(p.col = "p.adj",
                       cutpoints = c(0, 0.01, 0.05, 0.1, 1),
                       symbols = c( "***", "**", "*", "ns")) %>%
      as.data.table()
    test_stats_2 <- test_stats_2[stage == 2]
    
    
    plot_top <- ggplot(data = tmp,
           mapping = aes(x = as.factor(surprise),
                         y = outcome)) +
        geom_bar(aes(fill = stage),
                 position = "dodge", 
                 stat = "summary", 
                 fun = "mean") + 
      limits +
      scale_fill_manual(values=c("black", "gray")) +
      theme_classic() +
      stat_pvalue_manual(data = test_stats_2,
                         label = "{p} ({p.adj.signif})", 
                         step.group.by = "stage",
                         tip.length = 0, 
                         step.increase = 0.1, 
                         y.position = y_1) +
      stat_pvalue_manual(data = test_stats_1,
                         label = "{p} ({p.adj.signif})",
                         y.position = y_2,
                         tip.length = 0,
                         x = "surprise") +
      labs(title = "",
           x = " Surprising Condition",
           y = glue(" {response}"))
    
    rm(tmp)
    
    plot_top
  }
}

9.2 Figure OB.1

To create Figure fig-OB1 (and the other figures), we use the wrapper function defined above. We’ll call several times in what follows. As all the other figures presented in this document, Figure fig-OB1 consists of three panels, top, left, and right that are relatively similar. We thus, save both space and sources of error by creating a wrapper function plot_bars() that creates bar plots and annotates them with test statistics.

top   <- plot_bars(response = "E1", surprise_sub = NA)
left  <- plot_bars(response = "E1", surprise_sub = FALSE)
right <- plot_bars(response = "E1", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.1: Means of the matching probabilities for event E1 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

9.3 Figure OB.2

Next, we use the wrapper function again but visualize another outcome using the response == E2 argument.

top   <- plot_bars(response = "E2", surprise_sub = NA)
left  <- plot_bars(response = "E2", surprise_sub = FALSE)
right <- plot_bars(response = "E2", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.2: Means of the matching probabilities for event E2 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

9.4 Figure OB.3

Next, we use the wrapper function again but visualize another outcome using the response == E3 argument.

top   <- plot_bars(response = "E3", surprise_sub = NA)
left  <- plot_bars(response = "E3", surprise_sub = FALSE)
right <- plot_bars(response = "E3", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.3: Means of the matching probabilities for event E3 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

9.5 Figure OB.4

Next, we use the wrapper function again but visualize another outcome using the response == E12 argument.

top   <- plot_bars(response = "E12", surprise_sub = NA)
left  <- plot_bars(response = "E12", surprise_sub = FALSE)
right <- plot_bars(response = "E12", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.4: Means of the matching probabilities for event E12 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

9.6 Figure OB.5

Next, we use the wrapper function again but visualize another outcome using the response == E13 argument.

top   <- plot_bars(response = "E13", surprise_sub = NA)
left  <- plot_bars(response = "E13", surprise_sub = FALSE)
right <- plot_bars(response = "E13", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.5: Means of the matching probabilities for event E13 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

9.7 Figure OB.6

Next, we use the wrapper function again but visualize another outcome using the response == E23 argument.

top   <- plot_bars(response = "E23", surprise_sub = NA)
left  <- plot_bars(response = "E23", surprise_sub = FALSE)
right <- plot_bars(response = "E23", surprise_sub = TRUE)

(top / (left | right) & theme(legend.position = "bottom")) + plot_layout(guides = "collect")

Figure 9.6: Means of the matching probabilities for event E23 separated by treatments and part 1 and part 2. P-values of Wilcoxon signed-rank test comparing part 1 and 2 directly above the mean values. P-values of Wilcoxon–Mann–Whitney test comparing part 2 of different treatments at the top. Note: ∗p<0.10, ∗∗p<0.05, ∗∗∗p<0.01, ns: not significant

Session Info

sessionInfo()

R version 4.4.1 (2024-06-14)
Platform: x86_64-apple-darwin20
Running under: macOS Sonoma 14.4.1

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: Europe/Zurich
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] patchwork_1.2.0   rstatix_0.7.2     ggpubr_0.6.0      ggplot2_3.5.1    
 [5] lmtest_0.9-40     zoo_1.8-12        sandwich_3.1-0    glue_1.7.0       
 [9] knitr_1.48        lubridate_1.9.3   stringr_1.5.1     data.table_1.15.4
[13] magrittr_2.0.3   

loaded via a namespace (and not attached):
 [1] utf8_1.2.4        generics_0.1.3    tidyr_1.3.1       stringi_1.8.4    
 [5] lattice_0.22-6    digest_0.6.36     evaluate_0.24.0   grid_4.4.1       
 [9] timechange_0.3.0  fastmap_1.2.0     jsonlite_1.8.8    backports_1.5.0  
[13] groundhog_3.2.0   purrr_1.0.2       fansi_1.0.6       scales_1.3.0     
[17] abind_1.4-5       cli_3.6.3         rlang_1.1.4       munsell_0.5.1    
[21] withr_3.0.1       yaml_2.3.10       tools_4.4.1       parallel_4.4.1   
[25] ggsignif_0.6.4    dplyr_1.1.4       colorspace_2.1-1  broom_1.0.6      
[29] vctrs_0.6.5       R6_2.5.1          lifecycle_1.0.4   car_3.1-2        
[33] htmlwidgets_1.6.4 pkgconfig_2.0.3   pillar_1.9.0      gtable_0.3.5     
[37] xfun_0.46         tibble_3.2.1      tidyselect_1.2.1  rstudioapi_0.16.0
[41] farver_2.1.2      htmltools_0.5.8.1 labeling_0.4.3    carData_3.0-5    
[45] rmarkdown_2.27    compiler_4.4.1